library(readxl)
happy <- list()#raw data
p <- 15;
n <- 33;
nindex <- 18
nmst <- rep(0,15); #number of missing values by time points
for (m in 1:nindex)
{
#p*n
happy[[m]] <- apply(t(as.matrix(read_xlsx("/Users/siyan/Desktop/Supplementary materials/R software code/originaldata.xlsx",sheet=m))[,-1]),2,as.numeric)
tmp <- is.na(happy[[m]]);
nmst <- nmst + rowSums(tmp);
}
#transform nmst log directly & polynomial fit
tmpDF <- data.frame(x=1:p,y=log(nmst));
mymdl <- lm(y ~ poly(x,2), data=tmpDF);#mymdl <- loess(y ~ x, data=tmpDF, span=0.75, control=loess.control(surface="direct"),degree=2);#defaults "span=0.75"
myfit <- exp(predict(mymdl,data.frame(x = 1:p)));
print(myfit)
mycolor <- rgb(red=runif(1),green=runif(1),blue=runif(1));
plot(1:p,myfit,ylim=c(min(myfit),max(myfit)),type='l',xaxt="n",col=mycolor, ylab=paste("#missing"),,xlab = "Year");
axis(1,at=1:15,labels=c(2005:2019),cex.axis=1)
points(1:p,nmst,col=mycolor);
Invweight_fit=(1/myfit)/sum(1/myfit);
print(Invweight_fit);
saveRDS(Invweight_fit,"/Users/siyan/Desktop/sustainability/weighttms.RDS")
library(readxl)
happy <- list()#raw data
p <- 15;
n <- 33;
nindex <- 18
nmst <- rep(0,15); #number of missing values by time points
for (m in 1:nindex)
{
#p*n
happy[[m]] <- apply(t(as.matrix(read_xlsx("/Users/siyan/Desktop/Supplementary materials/R software code/originaldata.xlsx",sheet=m))[,-1]),2,as.numeric)
tmp <- is.na(happy[[m]]);
nmst <- nmst + rowSums(tmp);
}
#transform nmst log directly & polynomial fit
tmpDF <- data.frame(x=1:p,y=log(nmst));
mymdl <- lm(y ~ poly(x,2), data=tmpDF);#mymdl <- loess(y ~ x, data=tmpDF, span=0.75, control=loess.control(surface="direct"),degree=2);#defaults "span=0.75"
myfit <- exp(predict(mymdl,data.frame(x = 1:p)));
print(myfit)
mycolor <- rgb(red=runif(1),green=runif(1),blue=runif(1));
plot(1:p,myfit,ylim=c(min(myfit),max(myfit)),type='l',xaxt="n",col=mycolor, ylab=paste("#missing"),,xlab = "Year");
axis(1,at=1:15,labels=c(2005:2019),cex.axis=1)
points(1:p,nmst,col=mycolor);
Invweight_fit=(1/myfit)/sum(1/myfit);
print(Invweight_fit);
saveRDS(Invweight_fit,"/Users/siyan/Desktop/Supplementary materials/R software code/weighttms.RDS")
library(readxl)
source("/Users/siyan/Desktop/Supplementary materials/R software codeFDregsmooth.R")
# generate smoothed data
p <- 15#100;
nindex <- 18;
Ytp <- (0:(p-1))/(p-1);
Ftp <- (0:(p-1))/(p-1);
dm <- list() # smoothed data, list NO: 18 variables , matrix p*n: 15*33, 15 is year number and 33 is city number
happy <- list() # raw data
newMeans <- list()
fileName <- "/Users/siyan/Desktop/Supplementary materials/R software codeoriginaldata.xlsx";
for (m in 1:nindex)
{
happy[[m]] <- apply(t(as.matrix(read_xlsx(fileName,sheet=m))[,-1]),2,as.numeric)
happys <- MX2FD_lpk2(happy[[m]],Ytp,Ftp,span=0.75,degree=2);#happy[[m]]#no smooth
dm[[m]] <- happys;
#plot
Y <- happys; Yo <- happy[[m]];
mycolor <- rgb(red=runif(1),green=runif(1),blue=runif(1));
plot(Ftp,Y[,1],ylim=c(min(Y),max(Y)),type='l',col=mycolor);
points(Ytp,Yo[,1],col=mycolor);
for(i in 2:ncol(Y))
{
mycolor <- rgb(red=runif(1),green=runif(1),blue=runif(1));
lines(Ftp,Y[,i],col=mycolor);
points(Ytp,Yo[,i],col=mycolor);
}
#i=i+1; mycolor <- rgb(red=runif(1),green=runif(1),blue=runif(1));plot(Ftp,Y[,i],ylim=c(min(Y),max(Y)),type='l',col=mycolor, ylab=paste("i=",i));points(Ytp,Yo[,i],col=mycolor);
}
dmnew <- array(dim=c(15,nindex,33)) # smoothed data, list NO: 33 cities , matrix p*v: 15*20, 15 is year number and 18 is variable number
for (i in 1:33)
{
for (j in 1: nindex)
{
dmnew[,j,i] <- dm[[j]][,i]
}
}
saveRDS(dmnew,file="/Users/siyan/Desktop/Supplementary materials/R software codedatasmnew830.Rds")
library(readxl)
source("/Users/siyan/Desktop/Supplementary materials/R software code/FDregsmooth.R")
# generate smoothed data
p <- 15#100;
nindex <- 18;
Ytp <- (0:(p-1))/(p-1);
Ftp <- (0:(p-1))/(p-1);
dm <- list() # smoothed data, list NO: 18 variables , matrix p*n: 15*33, 15 is year number and 33 is city number
happy <- list() # raw data
newMeans <- list()
fileName <- "/Users/siyan/Desktop/Supplementary materials/R software code/originaldata.xlsx";
for (m in 1:nindex)
{
happy[[m]] <- apply(t(as.matrix(read_xlsx(fileName,sheet=m))[,-1]),2,as.numeric)
happys <- MX2FD_lpk2(happy[[m]],Ytp,Ftp,span=0.75,degree=2);#happy[[m]]#no smooth
dm[[m]] <- happys;
#plot
Y <- happys; Yo <- happy[[m]];
mycolor <- rgb(red=runif(1),green=runif(1),blue=runif(1));
plot(Ftp,Y[,1],ylim=c(min(Y),max(Y)),type='l',col=mycolor);
points(Ytp,Yo[,1],col=mycolor);
for(i in 2:ncol(Y))
{
mycolor <- rgb(red=runif(1),green=runif(1),blue=runif(1));
lines(Ftp,Y[,i],col=mycolor);
points(Ytp,Yo[,i],col=mycolor);
}
#i=i+1; mycolor <- rgb(red=runif(1),green=runif(1),blue=runif(1));plot(Ftp,Y[,i],ylim=c(min(Y),max(Y)),type='l',col=mycolor, ylab=paste("i=",i));points(Ytp,Yo[,i],col=mycolor);
}
dmnew <- array(dim=c(15,nindex,33)) # smoothed data, list NO: 33 cities , matrix p*v: 15*20, 15 is year number and 18 is variable number
for (i in 1:33)
{
for (j in 1: nindex)
{
dmnew[,j,i] <- dm[[j]][,i]
}
}
saveRDS(dmnew,file="/Users/siyan/Desktop/Supplementary materials/R software code/datasmnew830.Rds")
library(factoextra)
library(openxlsx)
library(readxl)
#source("kmeansGeneral.R")
#specify the number of clusters expected to get
GL_k <- 5;#k=4 with "ward.D" hie initial
GL_nindex <- 18;#number of indices/variables in dataset
GL_nobs <- 33;#number of observations/cities
GL_ntp <- 15;#number of time points
GL_weightt <- readRDS("/Users/siyan/Desktop/Supplementary materials/R software code/weighttms.RDS");
GL_myData<-readRDS("/Users/siyan/Desktop/Supplementary materials/R software code/datasmnew830.Rds");#lpsm
#data pre-process:
#normalize by min and max to 0-1
source("/Users/siyan/Desktop/Supplementary materials/R software code/datapre.R");
GL_myDatanew<-array(dim=c(GL_ntp,GL_nindex,GL_nobs))
for (v in 1:GL_nindex)
{
for (j in 1:GL_ntp)
{
GL_myDatanew[j,v,] <- min.max.norm(GL_myData[j,v,])
}
}
GL_myData <- GL_myDatanew;
source("/Users/siyan/Desktop/Supplementary materials/R software code/calewm.R");
#entropy weights
GL_weightv <- c(calewm(GL_myData[,1:6,]),calewm(GL_myData[,6+(1:7),]),
calewm(GL_myData[,6+7+(1:5),]));
GL_weightv
source("/Users/siyan/Desktop/Supplementary materials/R software code/citydis.R");
#choose distance
GL_disType <- 3;#L2-type
source("/Users/siyan/Desktop/Supplementary materials/R software code/initialkmeans-hier.R");
aggmethod <- "ward.D"#"ward.D"#"ward.D2"#"ward.D";##
#ward.D", "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC).
#minimax
hresult<-inithier(GL_k,GL_disType,aggmethod);
citylist<-as.matrix(c(1:33))
city_name <- as.matrix(read.xlsx('/Users/siyan/Desktop/Supplementary materials/R software code/originaldata.xlsx','city'))[,1];
citycluster<-c(city_name[citylist[1,]],city_name[citylist[2,]],city_name[citylist[3,]],
city_name[citylist[4,]],city_name[citylist[5,]],city_name[citylist[6,]],
city_name[citylist[7,]],city_name[citylist[8,]],city_name[citylist[9,]],
city_name[citylist[10,]],city_name[citylist[11,]],city_name[citylist[12,]],
city_name[citylist[13,]],city_name[citylist[14,]],city_name[citylist[15,]],
city_name[citylist[16,]],city_name[citylist[17,]],city_name[citylist[18,]],
city_name[citylist[19,]],city_name[citylist[20,]],city_name[citylist[21,]],
city_name[citylist[22,]],city_name[citylist[23,]],city_name[citylist[24,]],
city_name[citylist[25,]],city_name[citylist[26,]],city_name[citylist[27,]],
city_name[citylist[28,]],city_name[citylist[29,]],city_name[citylist[30,]],
city_name[citylist[31,]],city_name[citylist[32,]],city_name[citylist[33,]])
hresult$labels<-citycluster
plot(hresult,hang=-1);
#whether use cuttree to determine clusters automatically
CT <- TRUE;
#CT <- FALSE;
if(CT)#use cuttree
{
if(aggmethod!="minimax") {GL_initcls <- cutree(hresult,GL_k);}
else {GL_initcls <- protocut(hresult, GL_k)$cl;}
}
print(GL_initcls);print(table(GL_initcls));
rcls <- GL_initcls;
fviz_dend(hresult, k = 5,
cex = 1,
k_colors = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07","purple"),
color_labels_by_k = TRUE,
rect = TRUE
)
fviz_dend(hresult,k=5,rect =T,rect_fill = T,type = "circular",
rect_border = c("#2E9FDF", "#00AFBB", "#E7B800", "#FC4E07","purple"))
for(i in 1:GL_k)
{
print(city_name[which(rcls==i)]);
print("========");
}
# calculate the index
# define an overall benchmark, choose the minimum value of each year and index
# define a group-wise benchmark, choose the minimum value of each year and index of every group
source("/Users/siyan/Desktop/Supplementary materials/R software code/Example_hclust.R");
bench <- matrix(,GL_ntp,GL_nindex)
for (iyear in 1:GL_ntp)
{
for (v in 1:GL_nindex)
{
bench[iyear,v]<-min(GL_myData[iyear,v,])
}
}
calDisObsbench <- function(obs_i,bench,weightt,weightv,type){
obsi <- GL_myData[,,obs_i];
# obsj <- myData[,,obs_j];
dis <- 0;
for (v in 1:GL_nindex)#indices
{
if(type==1)
{
tmpdis <- sum(weightt*(obsi[,v]-bench[,v])^2)/sum((GL_poolSDs[,v])^2);
}else if(type==2)
{
tmpdis <- sum(weightt*((obsi[,v]-bench[,v])/GL_poolSDs[,v])^2);
}else{
tmpdis <- sum(weightt*(obsi[,v]-bench[,v])^2)
}
dis <- dis+weightv[v]*tmpdis;
}
return(dis);
}
dis2bench <- rep(0,33);
for(j in 1:33)
{ #dis between jth obs and the benchmark
dis2bench[j] <- calDisObsbench(j,bench,weightt=GL_weightt,weightv=GL_weightv,type=GL_disType);
}
# calculate the average distances to benchmark of every group
groupdis<-rep(0,GL_k)
for(i in 1:GL_k)
{
groupdis[i] <- mean(dis2bench[which(rcls==i)]);
}
groupord<-order(groupdis,decreasing=T)
